home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / gnus / gnusmail.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  7.8 KB  |  238 lines

  1. ;;; gnusmail.el --- mail reply commands for GNUS newsreader
  2.  
  3. ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  6. ;; Keywords: news
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; Provides mail reply and mail other window command using usual mail
  27. ;; interface and mh-e interface.
  28. ;; 
  29. ;; To use MAIL: set the variables gnus-mail-reply-method and
  30. ;; gnus-mail-other-window-method to gnus-mail-reply-using-mail and
  31. ;; gnus-mail-other-window-using-mail, respectively.
  32. ;;
  33. ;; To use MH-E: set the variables gnus-mail-reply-method and
  34. ;; gnus-mail-other-window-method to gnus-mail-reply-using-mhe and
  35. ;; gnus-mail-other-window-using-mhe, respectively.
  36.  
  37. ;;; Code:
  38.  
  39. (require 'gnus)
  40.  
  41. (autoload 'news-mail-reply "rnewspost")
  42. (autoload 'news-mail-other-window "rnewspost")
  43.  
  44. (autoload 'mh-send "mh-e")
  45. (autoload 'mh-send-other-window "mh-e")
  46. (autoload 'mh-find-path "mh-e")
  47. (autoload 'mh-yank-cur-msg "mh-e")
  48.  
  49. ;;; Mail reply commands of GNUS Summary Mode
  50.  
  51. (defun gnus-summary-reply (yank)
  52.   "Reply mail to news author.
  53. If prefix argument YANK is non-nil, original article is yanked automatically.
  54. Customize the variable gnus-mail-reply-method to use another mailer."
  55.   (interactive "P")
  56.   ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
  57.   ;; Stripping headers should be specified with mail-yank-ignored-headers.
  58.   (gnus-summary-select-article t t)
  59.   (switch-to-buffer gnus-article-buffer)
  60.   (widen)
  61.   (delete-other-windows)
  62.   (bury-buffer gnus-article-buffer)
  63.   (funcall gnus-mail-reply-method yank))
  64.  
  65. (defun gnus-summary-reply-with-original ()
  66.   "Reply mail to news author with original article.
  67. Customize the variable gnus-mail-reply-method to use another mailer."
  68.   (interactive)
  69.   (gnus-summary-reply t))
  70.  
  71. (defun gnus-summary-mail-forward ()
  72.   "Forward the current message to another user.
  73. Customize the variable gnus-mail-forward-method to use another mailer."
  74.   (interactive)
  75.   (gnus-summary-select-article)
  76.   (switch-to-buffer gnus-article-buffer)
  77.   (widen)
  78.   (delete-other-windows)
  79.   (bury-buffer gnus-article-buffer)
  80.   (funcall gnus-mail-forward-method))
  81.  
  82. (defun gnus-summary-mail-other-window ()
  83.   "Compose mail in other window.
  84. Customize the variable gnus-mail-other-window-method to use another mailer."
  85.   (interactive)
  86.   (gnus-summary-select-article)
  87.   (switch-to-buffer gnus-article-buffer)
  88.   (widen)
  89.   (delete-other-windows)
  90.   (bury-buffer gnus-article-buffer)
  91.   (funcall gnus-mail-other-window-method))
  92.  
  93.  
  94. ;;; Send mail using sendmail mail mode.
  95.  
  96. (defun gnus-mail-reply-using-mail (&optional yank)
  97.   "Compose reply mail using mail.
  98. Optional argument YANK means yank original article."
  99.   (news-mail-reply)
  100.   (gnus-overload-functions)
  101.   (if yank
  102.       (let ((last (point)))
  103.     (goto-char (point-max))
  104.     (mail-yank-original nil)
  105.     (goto-char last)
  106.     )))
  107.  
  108. ;; XEmacs change
  109. (defvar gnus-forward-header-function
  110.   (function (lambda ()
  111.           (concat "[" gnus-newsgroup-name "] "
  112.               (or (gnus-fetch-field "Subject") "")))))
  113.  
  114. (defun gnus-mail-forward-using-mail ()
  115.   "Forward the current message to another user using mail, RFC944 style."
  116.   ;; This is almost a carbon copy of rmail-forward in rmail.el.
  117.   (let ((forward-buffer (current-buffer))
  118.     (subject (funcall gnus-forward-header-function)))
  119.     ;; If only one window, use it for the mail buffer.
  120.     ;; Otherwise, use another window for the mail buffer
  121.     ;; so that the Rmail buffer remains visible
  122.     ;; and sending the mail will get back to it.
  123.     (if (if (one-window-p t)
  124.         (mail nil nil subject)
  125.       (mail-other-window nil nil subject))
  126.     (save-excursion
  127.       (goto-char (point-max))
  128.       (or (bolp) (insert "\n"))     ;XEmacs addition
  129.       (insert "------- Start of forwarded message -------\n")
  130.           ;; XEmacs change
  131.       (let ((p (point)))
  132.         (insert-buffer forward-buffer)
  133.         (goto-char p)
  134.         (while (re-search-forward "^-" nil t)
  135.           (insert " -")))
  136.       (goto-char (point-max))
  137.       (insert "\n------- End of forwarded message -------\n")
  138.       ;; You have a chance to arrange the message.
  139.       (run-hooks 'gnus-mail-forward-hook)
  140.       ))))
  141.  
  142. (defun gnus-mail-other-window-using-mail ()
  143.   "Compose mail other window using mail."
  144.   (news-mail-other-window)
  145.   (gnus-overload-functions))
  146.  
  147.  
  148. ;;; Send mail using mh-e.
  149.  
  150. ;; The following mh-e interface is all cooperative works of
  151. ;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
  152. ;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
  153. ;; SHINGU).
  154.  
  155. (defun gnus-mail-reply-using-mhe (&optional yank)
  156.   "Compose reply mail using mh-e.
  157. Optional argument YANK means yank original article.
  158. The command \\[mh-yank-cur-msg] yank the original message into current buffer."
  159.   ;; First of all, prepare mhe mail buffer.
  160.   (let (from cc subject date to reply-to (buffer (current-buffer)))
  161.     (save-restriction
  162.       (gnus-article-show-all-headers)    ;I don't think this is really needed.
  163.       (setq from (gnus-fetch-field "from")
  164.         subject (let ((subject (gnus-fetch-field "subject")))
  165.               (if (and subject
  166.                    (not (string-match "^[Rr][Ee]:.+$" subject)))
  167.               (concat "Re: " subject) subject))
  168.         reply-to (gnus-fetch-field "reply-to")
  169.         cc (gnus-fetch-field "cc")
  170.         date (gnus-fetch-field "date"))
  171.       (setq mh-show-buffer buffer)
  172.       (setq to (or reply-to from))
  173.       (mh-find-path)
  174.       (mh-send to (or cc "") (or subject ""))
  175.       (save-excursion
  176.     (mh-insert-fields
  177.      "In-reply-to:"
  178.      (concat
  179.       (substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
  180.       "'s message of " date)))
  181.       (setq mh-sent-from-folder buffer)
  182.       (setq mh-sent-from-msg 1)
  183.       ))
  184.   ;; Then, yank original article if requested.
  185.   (if yank
  186.       (let ((last (point)))
  187.     (mh-yank-cur-msg)
  188.     (goto-char last)
  189.     )))
  190.  
  191. ;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
  192. ;; <itojun@ingram.mt.cs.keio.ac.jp>
  193.  
  194. (defun gnus-mail-forward-using-mhe ()
  195.   "Forward the current message to another user using mh-e."
  196.   ;; First of all, prepare mhe mail buffer.
  197.   (let ((to (read-string "To: "))
  198.      (cc (read-string "Cc: "))
  199.      (buffer (current-buffer))
  200.      subject)
  201.     ;;(gnus-article-show-all-headers)
  202.     (setq subject (funcall gnus-forward-header-function)) ;XEmacs change
  203.     (setq mh-show-buffer buffer)
  204.     (mh-find-path)
  205.     (mh-send to (or cc "") subject)
  206.     (save-excursion
  207.       (goto-char (point-max))
  208.       (insert "\n------- Forwarded Message\n\n")
  209.       ;; XEmacs change
  210.       (let ((p (point)))
  211.     (insert-buffer buffer)
  212.     (goto-char p)
  213.     (while (re-search-forward "^-" nil t)
  214.       (insert " -")))
  215.       (goto-char (point-max))
  216.       (insert "\n------- End of Forwarded Message\n")
  217.       (setq mh-sent-from-folder buffer)
  218.       (setq mh-sent-from-msg 1)
  219.       ;; You have a chance to arrange the message.
  220.       (run-hooks 'gnus-mail-forward-hook) ;XEmacs change
  221.       )))
  222.  
  223. (defun gnus-mail-other-window-using-mhe ()
  224.   "Compose mail other window using mh-e."
  225.   (let ((to (read-string "To: "))
  226.     (cc (read-string "Cc: "))
  227.     (subject (read-string "Subject: " (gnus-fetch-field "subject"))))
  228.     (gnus-article-show-all-headers)    ;I don't think this is really needed.
  229.     (setq mh-show-buffer (current-buffer))
  230.     (mh-find-path)
  231.     (mh-send-other-window to cc subject)
  232.     (setq mh-sent-from-folder (current-buffer))
  233.     (setq mh-sent-from-msg 1)))
  234.  
  235. (provide 'gnusmail)
  236.  
  237. ;;; gnusmail.el ends here
  238.